1st Multimedia Mac Shareware/Multimedia Shareware CD-ROM - BetaCorp.iso/StackToolsƒ/XFCNƒ/StripIt/Source Code/StripIt.p

Text File | 1988-01-03 | 19.1 KB | 619 lines | [TEXT/PJMM]

{ --------------------------------------------------------------------    }
{ -----|  StripIt. p                        |----------------------------------    }
{ --------------------------------------------------------------------    }
{ -----|  Eric Celeste                        |----------------------------------    }
{ -----|  Appropriate Technology        |----------------------------------    }
{ -----|  358 North Parkview            |----------------------------------    }
{ -----|  Columbus, Ohio 43209            |----------------------------------    }
{ --------------------------------------------------------------------    }

{ Pascal source code for a Hypercard XFCN which strips the letters in the }
{ first item passed from the string passed in the second item. }

{ This XFCN is not meant to be very useful, but it does serve to show those }
{ of us using Lightspeed Pascal how to build HyperCard XFCNs and XCMDs. }
{ Now the next step is for someone out there to write a shell that we can use }
{ for debugging these things without having to go through the LSP/ResEd/HC }
{ cycle over and over again. }

{ Written in Lightspeed Pascal using the DA Paslib and HyperXCmd.p. }
{ The StripIt project should be built and saved as a code resource of the type }
{ XFCN and with the name “Strip”. Then that code resource should be copied }
{ with ResEdit into the Hypercard stack which needs to use this XFCN. }

{ --------------------------------------------------------------------    }
{ -----| Lightspeed Pascal Project should include:        |---------------------    }
{ --------------------------------------------------------------------    }
{ -----| MacTraps                                        |---------------------    }
{ -----| DA Paslib                                        |---------------------    }
{ -----| HyperXCmd.p                                    |---------------------    }
{ -----| StripIt.p                                            |---------------------    }
{ --------------------------------------------------------------------    }

{ --------------------------------------------------------------------    }
{ -----| Build & Save this project as:            |---------------------------    }
{ --------------------------------------------------------------------    }
{ -----|  •    Code Resource                        |---------------------------    }
{ -----|     Type: XFCN                            |---------------------------    }
{ -----|     ID: 7                                    |---------------------------    }
{ -----|     Name: Strip                            |---------------------------    }
{ --------------------------------------------------------------------    }

UNIT CoreUnit;

INTERFACE

    USES
        HyperXCmd;

{ When building a code resource, which this will be, LSP looks for a procedure }
{ called “Main” to use as the entrypoint for the code. This “Main” procedure }
{ must be declared here in the interface section of the unit you are compiling. }
{ Notice that this program is not really a program at all, since it does not have }
{ a “program” statement anywhere in it! }

    PROCEDURE Main (paramPtr : XCmdPtr);

IMPLEMENTATION

    PROCEDURE Main;    { declared in interface section with (paramPtr : XCmdPtr) }

        TYPE
            str31 = STRING[31];        { some of the XCmdGlue functions need this type }

        VAR
            theseChars : Str255;        { string holding characters we will strip out }
            stringToStrip : Str255;    { string which we will strip }
            result : Str255;            { this string will hold the result of the stripping }

{ -------------------------------------------------------    }
{ -----|  XCmdGlue.inc             |---------------------------    }
{ -------------------------------------------------------    }
{ These next few procedures are from the file included in the    }
{ HyperCard documentation. This file defines many useful         }
{ procedures for writing HyperCard XCMDs and XFCNs. You        }
{ will notice that many of these functions are not actually used    }
{ by this XFCN, I have included them anyway so that you can     }
{ see all of what is available.                                        }
{                                        You may wonder why these    }
{ functions are included at this particular place in the program.    }
{ Notice that many of the functions below use the record            }
{ “paramPtr” which is the XCmdPtr passed to the “Main”        }
{ function by HyperCard. Since this record is first declared in    }
{ the parameters of the “Main” function, these functions must    }
{ be included here, not in a library. If anyone knows of a less    }
{ clumbsy way of doing this, please share it with me!                }
{ -------------------------------------------------------    }

{ XCmdGlue.inc -- Sample glue routines to call back to HyperCard.  }
{  See example use in Peek.p and Flash.p}
{  By Dan Winkler.  DO NOT call the author!  Contact Apple Developer }
{  Support on AppleLink "MacDTS" or on MCI "MacTech".}
{}
{      ©Apple Computer, Inc. 1987}
{    All Rights Reserved.}
{}

{ The Pascal code for the XCMD or XFCN should include HyperXCmd.p at}
{  the beginning in the USES clause and this file at the end with the $I}
{  directive.  There must be a variable named "paramPtr" that is the argument}
{  that was passed into the XCMD or XFCN. All strings are Pascal strings }
{  unless noted as zero-terminated strings (no length byte and the string }
{  goes until a zero byte is encountered). }


        PROCEDURE DoJsr (addr : ProcPtr);
        INLINE
            $205F, $4E90;
{ Jump subroutine to a procedure.   Pop address into A0, JSR (A0) }

        PROCEDURE SendCardMessage (msg : Str255);
{  Send a HyperCard message (a command with arguments) to the current card. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@msg);
                    request := xreqSendCardMessage;
                    DoJsr(entryPoint);
                END;
        END;

        FUNCTION EvalExpr (expr : Str255) : Handle;
{  Evaluate a HyperCard expression and return the answer.  The answer is}
{   a handle to a zero-terminated string. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@expr);
                    request := xreqEvalExpr;
                    DoJsr(entryPoint);
                    EvalExpr := Handle(outArgs[1]);
                END;
        END;

        FUNCTION StringLength (strPtr : Ptr) : LongInt;
{  Count the characters from where strPtr points until the next zero byte. }
{   Does not count the zero itself.  strPtr must be a zero-terminated string.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(strPtr);
                    request := xreqStringLength;
                    DoJsr(entryPoint);
                    StringLength := outArgs[1];
                END;
        END;

        FUNCTION StringMatch (pattern : Str255;
                                        target : Ptr) : Ptr;
{ Perform case-insensitive match looking for pattern anywhere in}
{  target, returning a pointer to first character of the first match,}
{  in target or NIL if no match found.  pattern is a Pascal string,}
{  and target is a zero-terminated string. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@pattern);
                    inArgs[2] := ORD(target);
                    request := xreqStringMatch;
                    DoJsr(entryPoint);
                    StringMatch := Ptr(outArgs[1]);
                END;
        END;

        PROCEDURE SendHCMessage (msg : Str255);
{  Send a HyperCard message (a command with arguments) to HyperCard. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@msg);
                    request := xreqSendHCMessage;
                    DoJsr(entryPoint);
                END;
        END;

        PROCEDURE ZeroBytes (dstPtr : Ptr;
                                        longCount : LongInt);
{  Write zeros into memory starting at dstPtr and going for longCount }
{   number of bytes. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(dstPtr);
                    inArgs[2] := longCount;
                    request := xreqZeroBytes;
                    DoJsr(entryPoint);
                END;
        END;

        FUNCTION PasToZero (str : Str255) : Handle;
{  Convert a Pascal string to a zero-terminated string.  Returns a handle}
{   to a new zero-terminated string.  The caller must dispose the handle. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@str);
                    request := xreqPasToZero;
                    DoJsr(entryPoint);
                    PasToZero := Handle(outArgs[1]);
                END;
        END;

        PROCEDURE ZeroToPas (zeroStr : Ptr;
                                        VAR pasStr : Str255);
{  Fill the Pascal string with the contents of the zero-terminated}
{   string.  You create the Pascal string and pass it in as a VAR }
{   parameter.  Useful for converting the arguments of any XCMD to }
{   Pascal strings.}
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(zeroStr);
                    inArgs[2] := ORD(@pasStr);
                    request := xreqZeroToPas;
                    DoJsr(entryPoint);
                END;
        END;

        FUNCTION StrToLong (str : Str31) : LongInt;
{  Convert a string of ASCII decimal digits to an unsigned long integer. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@str);
                    request := xreqStrToLong;
                    DoJsr(entryPoint);
                    StrToLong := outArgs[1];
                END;
        END;

        FUNCTION StrToNum (str : Str31) : LongInt;
{  Convert a string of ASCII decimal digits to a signed long integer.}
{   Negative sign is allowed.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@str);
                    request := xreqStrToNum;
                    DoJsr(entryPoint);
                    StrToNum := outArgs[1];
                END;
        END;

        FUNCTION StrToBool (str : Str31) : BOOLEAN;
{  Convert the Pascal strings 'true' and 'false' to booleans. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@str);
                    request := xreqStrToBool;
                    DoJsr(entryPoint);
                    StrToBool := BOOLEAN(outArgs[1]);
                END;
        END;

        FUNCTION StrToExt (str : Str31) : Extended;
{  Convert a string of ASCII decimal digits to an extended long integer. }
            VAR
                x : Extended;
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@str);
                    inArgs[2] := ORD(@x);
                    request := xreqStrToExt;
                    DoJsr(entryPoint);
                    StrToExt := x;
                END;
        END;

        FUNCTION LongToStr (posNum : LongInt) : Str31;
{  Convert an unsigned long integer to a Pascal string.  }
            VAR
                str : Str31;
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := posNum;
                    inArgs[2] := ORD(@str);
                    request := xreqLongToStr;
                    DoJsr(entryPoint);
                    LongToStr := str;
                END;
        END;

        FUNCTION NumToStr (num : LongInt) : Str31;
{  Convert a signed long integer to a Pascal string.  }
            VAR
                str : Str31;
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := num;
                    inArgs[2] := ORD(@str);
                    request := xreqNumToStr;
                    DoJsr(entryPoint);
                    NumToStr := str;
                END;
        END;

        FUNCTION NumToHex (num : LongInt;
                                        nDigits : INTEGER) : Str31;
{  Convert an unsigned long integer to a hexadecimal number and put it}
{   into a Pascal string.  }
            VAR
                str : Str31;
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := num;
                    inArgs[2] := nDigits;
                    inArgs[3] := ORD(@str);
                    request := xreqNumToHex;
                    DoJsr(entryPoint);
                    NumToHex := str;
                END;
        END;

        FUNCTION BoolToStr (bool : BOOLEAN) : Str31;
{  Convert a boolean to 'true' or 'false'.  }
            VAR
                str : Str31;
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := LongInt(bool);
                    inArgs[2] := ORD(@str);
                    request := xreqBoolToStr;
                    DoJsr(entryPoint);
                    BoolToStr := str;
                END;
        END;

        FUNCTION ExtToStr (num : Extended) : Str31;
{  Convert an extended long integer to decimal digits in a string.  }
            VAR
                str : Str31;
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@num);
                    inArgs[2] := ORD(@str);
                    request := xreqExtToStr;
                    DoJsr(entryPoint);
                    ExtToStr := str;
                END;
        END;

        FUNCTION GetGlobal (globName : Str255) : Handle;
{  Return a handle to a zero-terminated string containing the value of }
{   the specified HyperTalk global variable.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@globName);
                    request := xreqGetGlobal;
                    DoJsr(entryPoint);
                    GetGlobal := Handle(outArgs[1]);
                END;
        END;

        PROCEDURE SetGlobal (globName : Str255;
                                        globValue : Handle);
{  Set the value of the specified HyperTalk global variable to be}
{   the zero-terminated string in globValue.  The contents of the }
{   Handle are copied, so you must still dispose it afterwards.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@globName);
                    inArgs[2] := ORD(globValue);
                    request := xreqSetGlobal;
                    DoJsr(entryPoint);
                END;
        END;

        FUNCTION GetFieldByName (cardFieldFlag : BOOLEAN;
                                        fieldName : Str255) : Handle;
{  Return a handle to a zero-terminated string containing the value of }
{   field fieldName on the current card.  You must dispose the handle.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(cardFieldFlag);
                    inArgs[2] := ORD(@fieldName);
                    request := xreqGetFieldByName;
                    DoJsr(entryPoint);
                    GetFieldByName := Handle(outArgs[1]);
                END;
        END;

        FUNCTION GetFieldByNum (cardFieldFlag : BOOLEAN;
                                        fieldNum : INTEGER) : Handle;
{  Return a handle to a zero-terminated string containing the value of }
{   field fieldNum on the current card.  You must dispose the handle.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(cardFieldFlag);
                    inArgs[2] := fieldNum;
                    request := xreqGetFieldByNum;
                    DoJsr(entryPoint);
                    GetFieldByNum := Handle(outArgs[1]);
                END;
        END;

        FUNCTION GetFieldByID (cardFieldFlag : BOOLEAN;
                                        fieldID : INTEGER) : Handle;
{  Return a handle to a zero-terminated string containing the value of }
{   the field whise ID is fieldID.  You must dispose the handle.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(cardFieldFlag);
                    inArgs[2] := fieldID;
                    request := xreqGetFieldByID;
                    DoJsr(entryPoint);
                    GetFieldByID := Handle(outArgs[1]);
                END;
        END;

        PROCEDURE SetFieldByName (cardFieldFlag : BOOLEAN;
                                        fieldName : Str255;
                                        fieldVal : Handle);
{  Set the value of field fieldName to be the zero-terminated string }
{   in fieldVal.  The contents of the Handle are copied, so you must }
{   still dispose it afterwards.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(cardFieldFlag);
                    inArgs[2] := ORD(@fieldName);
                    inArgs[3] := ORD(fieldVal);
                    request := xreqSetFieldByName;
                    DoJsr(entryPoint);
                END;
        END;

        PROCEDURE SetFieldByNum (cardFieldFlag : BOOLEAN;
                                        fieldNum : INTEGER;
                                        fieldVal : Handle);
{  Set the value of field fieldNum to be the zero-terminated string }
{   in fieldVal.  The contents of the Handle are copied, so you must }
{   still dispose it afterwards.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(cardFieldFlag);
                    inArgs[2] := fieldNum;
                    inArgs[3] := ORD(fieldVal);
                    request := xreqSetFieldByNum;
                    DoJsr(entryPoint);
                END;
        END;

        PROCEDURE SetFieldByID (cardFieldFlag : BOOLEAN;
                                        fieldID : INTEGER;
                                        fieldVal : Handle);
{  Set the value of the field whose ID is fieldID to be the zero-}
{   terminated string in fieldVal.  The contents of the Handle are }
{   copied, so you must still dispose it afterwards.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(cardFieldFlag);
                    inArgs[2] := fieldID;
                    inArgs[3] := ORD(fieldVal);
                    request := xreqSetFieldByID;
                    DoJsr(entryPoint);
                END;
        END;

        FUNCTION StringEqual (str1, str2 : Str255) : BOOLEAN;
{  Return true if the two strings have the same characters.  }
{   Case insensitive compare of the strings.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@str1);
                    inArgs[2] := ORD(@str2);
                    request := xreqStringEqual;
                    DoJsr(entryPoint);
                    StringEqual := BOOLEAN(outArgs[1]);
                END;
        END;

        PROCEDURE ReturnToPas (zeroStr : Ptr;
                                        VAR pasStr : Str255);
{  zeroStr points into a zero-terminated string.  Collect the }
{   characters from there to the next carriage Return and return }
{   them in the Pascal string pasStr.  If a Return is not found, }
{   collect chars until the end of the string. }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(zeroStr);
                    inArgs[2] := ORD(@pasStr);
                    request := xreqReturnToPas;
                    DoJsr(entryPoint);
                END;
        END;

        PROCEDURE ScanToReturn (VAR scanPtr : Ptr);
{  Move the pointer scanPtr along a zero-terminated }
{   string until it points at a Return character}
{   or a zero byte.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@scanPtr);
                    request := xreqScanToReturn;
                    DoJsr(entryPoint);
                END;
        END;

        PROCEDURE ScanToZero (VAR scanPtr : Ptr);
{  Move the pointer scanPtr along a zero-terminated }
{   string until it points at a zero byte.  }
        BEGIN
            WITH paramPtr^ DO
                BEGIN
                    inArgs[1] := ORD(@scanPtr);
                    request := xreqScanToZero;
                    DoJsr(entryPoint);
                END;
        END;

{ -------------------------------------------------------    }
{ -----|  End of XCmdGlue.inc     |---------------------------    }
{ -------------------------------------------------------    }


{ -------------------------------------------------------    }
{ -----|  Strip Procedure         |---------------------------    }
{ -------------------------------------------------------    }
{ This is the heart of the HyperCard Strip function. Note that    }
{ no parameters are passed into it since what it needs is         }
{ already global to this procedure, having been declared up at    }
{ the start of “Main”.                                                 }
{                                Strip takes the characters in the    }
{ string that was the first parameter from HyperCard, now        }
{ called theseCharacters, and creates a set that includes only    }
{ these characters. It then steps through what was the second    }
{ parameter from HyperCard, now called stringToStrip, and        }
{ checks to see if each character in this string is in the set of    }
{ characters it is to strip. If a character is not in that set,        }
{ then the procedure concatinates that character to the result    }
{ that will eventually be passed back to HyperCard. Since the    }
{ result will never have a character concatinated that is in the    }
{ set being stripped, the result will be devoid of the characters    }
{ in the first parameter from HyperCard.                            }
{ -------------------------------------------------------    }

        PROCEDURE Strip;

            TYPE
                charset = SET OF char;                    { this is what it sounds like }

            VAR
                stripset : charset;                        { this set will hold the characters to strip }
                numberOfChars, position : Integer;        { hold the length and place in strings }
                aChar : char;                                { temporary holder for individual characters }

        BEGIN        { start of the Strip procedure }

        { start with an empty set }
            stripset := [];

        { add the characters we want to strip to the set }
            numberOfChars := Length(theseChars);
            position := 1;
            WHILE position <= numberOfChars DO
                BEGIN
                    aChar := Copy(theseChars, position, 1);
                    stripset := stripset + [aChar];
                    position := position + 1;
                END;

        { and finally, copy the characters not to be stripped to the result }
            result := '';
            numberOfChars := Length(stringToStrip);
            position := 1;
            WHILE position <= numberOfChars DO
                BEGIN
                    aChar := Copy(stringToStrip, position, 1);
                    IF aChar IN stripset THEN
                        BEGIN
                { in this case we skip this letter altogether }
                        END
                    ELSE
                        BEGIN
                { in this case we add this letter to the result }
                            result := Concat(result, aChar);
                        END;
                    position := position + 1;
                END;

        END;        { end of the Strip procedure }

{ -------------------------------------------------------    }
{ -----|  End of Strip Procedure |---------------------------    }
{ -------------------------------------------------------    }


    BEGIN        { main (the entrypoint) }

        { first convert the parameters passed from HyperCard into Pascal-type strings }
        ZeroToPas(paramPtr^.Params[1]^, theseChars);
        ZeroToPas(paramPtr^.Params[2]^, stringToStrip);

        { then do the stripping }
        Strip;        { see the function above for the details of how this is done }

        { and finally put the result where HyperCard will be able to find it }
        paramPtr^.returnValue := PasToZero(result);

    END;            { main (the entrypoint) }


END.            { CoreUnit }